#!/usr/bin/perl -w
########################################################################
# test.pl - test script for XML::Writer module.
# Copyright (c) 1999 by Megginson Technologies.
# Copyright (c) 2004 - 2006 by Joseph Walton <joe@kafsemo.org>.
# No warranty.  Commercial and non-commercial use freely permitted.
#
# $Id: 01_main.t 191 2008-12-01 22:30:22Z josephw $
########################################################################

# Before 'make install' is performed this script should be runnable with
# 'make test'. After 'make install' it should work as 'perl 01_main.t'

use strict;

use Test::More(tests => 3);


# Catch warnings
my $warning;

$SIG{__WARN__} = sub {
	($warning) = @_ unless ($warning);
};

sub wasNoWarning($)
{
	my ($reason) = @_;

	if (!ok(!$warning, $reason)) {
		diag($warning);
	}
}

# Constants for Unicode support
my $unicodeSkipMessage = 'Unicode only supported with Perl >= 5.8.1';

sub isUnicodeSupported()
{
	return $] >= 5.008001;
}

require XML::Writer::Nest;

SKIP: {
	skip "Perls before 5.6 always warn when loading XML::Writer", 1 if $] <= 
	5.006;

	wasNoWarning('Loading XML::Writer should not result in warnings');
}

use IO::File;

# The XML::Writer that will be used
my $w;

my $outputFile = IO::File->new_tmpfile or die "Unable to create temporary file: $!";

# Fetch the current contents of the scratch file as a scalar
sub getBufStr()
{
	local($/);
	binmode($outputFile, ':bytes') if isUnicodeSupported();
	$outputFile->seek(0, 0);
	return <$outputFile>;
}

# Set up the environment to run a test.
sub initEnv(@)
{
	my (%args) = @_;

	# Reset the scratch file
	$outputFile->seek(0, 0);
	$outputFile->truncate(0);
	binmode($outputFile, ':raw') if $] >= 5.006;

	# Overwrite OUTPUT so it goes to the scratch file
	$args{'OUTPUT'} = $outputFile;

	# Set NAMESPACES, unless it's present
	$args{'NAMESPACES'} = 1 unless(defined($args{'NAMESPACES'}));

	undef($warning);
	$w = new XML::Writer(%args) || die "Cannot create XML writer";
}

#
# Check the results in the temporary output file.
#
# $expected - the exact output expected
#
sub checkResult($$)
{
	my ($expected, $explanation) = (@_);

	my $actual = getBufStr();

	if ($expected eq $actual) {
		ok(1, $explanation);
	} else {
		my @e = split(/\n/, $expected);
		my @a = split(/\n/, $actual);

		if (@e + @a == 2) {
			is(getBufStr(), $expected, $explanation);
		} else {
			if (eval {require Algorithm::Diff;}) {
				fail($explanation);

				Algorithm::Diff::traverse_sequences( \@e, \@a, {
					MATCH => sub { diag(" $e[$_[0]]\n"); },
					DISCARD_A => sub { diag("-$e[$_[0]]\n"); },
					DISCARD_B => sub { diag("+$a[$_[1]]\n"); }
				});
			} else {
				fail($explanation);
				diag("         got: '$actual'\n");
				diag("    expected: '$expected'\n");
			}
		}
	}

	wasNoWarning('(no warnings)');
}

#
# Expect an error of some sort, and check that the message matches.
#
# $pattern - a regular expression that must match the error message
# $value - the return value from an eval{} block
#
sub expectError($$) {
	my ($pattern, $value) = (@_);
	if (!ok((!defined($value) and ($@ =~ $pattern)), "Error expected: $pattern"))
	{
		diag('Actual error:');
		if ($@) {
			diag($@);
		} else {
			diag('(no error)');
			diag(getBufStr());
		}
	}
}

# Empty element tag.
TEST: {
	initEnv();
	
     {  my $level1 = XML::Writer::Nest->new(tag => 'level1', writer => $w);

	#use Data::Dumper;
	#die Data::Dumper->Dump([$level1],['level1']);


        {  my $level2 = $level1->nest(level2 => [ attr1 => 3 ] ); # or call the class conc. again.
     
	   $w->dataElement('meaning' => 42);

           {  my $level3 = $level2->nest('level3' => attr3 => 4);


           } # endTag created automatically


        } # endTag created automatically

    } # endTag created automatically



	$w->end();
	checkResult('<level1><level2 attr1="3"><meaning>42</meaning><level3 attr3="4"></level3></level2></level1>' . "\n", 'Nested tags');
};

# Free test resources
$outputFile->close() or die "Unable to close temporary file: $!";

1;

__END__
